PC Plus SuperCD (UK) 1997 May/PC Plus Super CD Issue 127 (May 1997).iso/componen/powerbld/demo/pbdemo.bas

BASIC Source File | 1996-06-30 | 6.6 KB | 318 lines

'==============================================================================
' File: PBDEMO.BAS
' Desc: Demo program for PB/DLL
'------------------------------------------------------------------------------

$COMPILE DLL
$DIM     ALL

%NULL  = 0
%True  = -1
%False = 0
%Size  = 8190

GLOBAL pbArray() AS LONG

'----------------------------------------------------------
'- pbFill
'----------------------------------------------------------

SUB pbFill(BYVAL nTimes as INTEGER) EXPORT

  DIM k               AS LONG
  REDIM pbArray(nTimes) AS LONG

  FOR k = 0 TO nTimes
    pbArray(k) = (32767 * RND + 1)
  NEXT k

END SUB

'----------------------------------------------------------
'- pbFillVb
'----------------------------------------------------------

SUB pbFillVb(BYVAL gArray AS DWORD, BYVAL nTimes AS INTEGER) EXPORT

  DIM k               AS LONG
  DIM vbArray         AS LONG PTR
  DIM pbArray(nTimes) AS GLOBAL LONG

  vbArray   = gArray

  FOR k = 0 TO nTimes
    @vbArray[K] = pbArray(K)
  NEXT

END SUB

'----------------------------------------------------------
'- pbSearch
'----------------------------------------------------------

SUB pbSearch(BYVAL nTimes as INTEGER, RetVal AS SINGLE) EXPORT

  DIM J               AS LONG
  DIM K               AS LONG
  DIM N               AS LONG
  DIM StartTime       AS SINGLE
  DIM pbArray(nTimes) AS GLOBAL LONG

  StartTime = TIMER

  FOR J = 0 TO nTimes
    N = pbArray(J)
    GOSUB SearchArray
  NEXT J

  RetVal = TIMER - StartTime
  EXIT SUB

SearchArray:

  FOR K = 0 TO nTimes
    IF pbArray(K) = N THEN EXIT FOR
  NEXT K

  RETURN

END SUB

'----------------------------------------------------------
'- pbSort
'----------------------------------------------------------

SUB pbSort(BYVAL nTimes AS INTEGER, RetVal AS SINGLE) EXPORT

  DIM J               AS LONG
  DIM K               AS LONG
  DIM Tmp             AS LONG
  DIM StartTime       AS SINGLE
  DIM pbArray(nTimes) AS GLOBAL LONG

  StartTime = TIMER

  FOR J = 0 TO nTimes - 1
    FOR K = 0 TO nTimes - J - 1
      IF pbArray(K) > pbArray(K + 1) THEN
       '-- Swap GlobArray(K+1) with GlobArray(k) ...
        Tmp = pbArray(K + 1)
        pbArray(K + 1) = pbArray(k)
        pbArray(K) = Tmp
      END IF
    NEXT K
  NEXT J

  RetVal = TIMER - StartTime

END SUB

'----------------------------------------------------------
'- pboSearch
'----------------------------------------------------------

SUB pboSearch(BYVAL nTimes as integer, RetVal AS SINGLE) EXPORT

  DIM I               AS LONG
  DIM j               AS LONG
  DIM k               AS LONG
  DIM n               AS LONG
  DIM StartTime       AS SINGLE
  DIM pbArray(nTimes) AS GLOBAL LONG

  StartTime = TIMER

  FOR J = 0 TO nTimes
    n = pbArray(J)
    GOSUB oSearchArray
  NEXT J

  RetVal = TIMER - StartTime
  EXIT SUB

oSearchArray:

  ARRAY SCAN pbArray(), = n, TO I
  RETURN

END SUB

'----------------------------------------------------------
'- pboSort
'----------------------------------------------------------

SUB pboSort(BYVAL nTimes AS INTEGER, RetVal AS SINGLE) EXPORT

  DIM StartTime       AS SINGLE
  DIM pbArray(nTimes) AS GLOBAL LONG

  StartTime = TIMER

  ARRAY SORT pbArray() FOR nTimes
  RetVal = TIMER - StartTime

END SUB

'----------------------------------------------------------
'- Sieve test
'----------------------------------------------------------

SUB PbSieve (BYVAL nIter AS INTEGER, RetVal AS SINGLE) EXPORT

  DIM StartTime    AS SINGLE
  DIM flags(%Size) AS INTEGER
  DIM Size         AS INTEGER
  DIM X            AS INTEGER
  DIM I            AS INTEGER
  DIM K            AS INTEGER
  DIM Count        AS INTEGER

  StartTime = TIMER

  FOR X = 1 TO nIter

    Count = %NULL

    FOR I = 0 TO %Size
      Flags(I) = %False
    NEXT

    FOR I = 2 TO %Size
      IF NOT (Flags(I)) THEN
        FOR K = I + I TO %Size STEP I
          Flags(K) = %True
        NEXT
        INCR Count
      END IF
    NEXT

  NEXT

  RetVal  = TIMER - StartTime

END SUB  ' pbSieve


'------------------------------------------------------------------------------
'- pbLongTest
'----------------------------------------------------------

SUB pbLongTest (ByVal nIters As Integer, RetVal As Single) EXPORT

  DIM StartTime AS SINGLE
  DIM I     AS INTEGER
  DIM J     AS INTEGER
  DIM K     AS LONG
  DIM Q     AS LONG
  DIM Y     AS LONG
  DIM Z     AS LONG

  StartTime = TIMER

  K = 7
  Y = 5
  Z = 1

  FOR I = 1 TO nIters
    FOR J = 1 TO nIters
      Q = Y
      Q = Z
      Q = Q + Y
      Q = Q + Z
      Q = Q - Y
      Q = Q - Z
      Q = K * Y
      Q = K \ Z
    NEXT
  NEXT

  RetVal = TIMER - StartTime

END SUB

'----------------------------------------------------------
'- Tak
'----------------------------------------------------------

FUNCTION Tak(BYVAL x AS INTEGER, BYVAL y AS INTEGER, BYVAL z AS INTEGER) AS INTEGER

  IF (y >= x) THEN
    FUNCTION = z
  ELSE
    FUNCTION = Tak( Tak(x-1,y,z), _
                    Tak(y-1,z,x), _
                    Tak(z-1,x,y))
  END IF

END FUNCTION

'----------------------------------------------------------
'- pbTak
'----------------------------------------------------------

SUB pbTak(BYVAL x AS INTEGER, BYVAL y AS INTEGER, BYVAL z AS INTEGER, _
          BYVAL nTimes AS INTEGER, RetVal AS SINGLE) EXPORT

  DIM StartTime AS SINGLE
  DIM I         AS INTEGER, _
      J         AS INTEGER

  StartTime = TIMER

  FOR I = 1 TO nTimes
    J = Tak(x, y, z)
  NEXT

  RetVal = TIMER - StartTime

END SUB

'----------------------------------------------------------
'- fnX
'----------------------------------------------------------

FUNCTION fnX() AS INTEGER

  FUNCTION = SIN(COS(SIN(.8)))

END FUNCTION

'----------------------------------------------------------
'- pbOpt
'----------------------------------------------------------

SUB pbShort(BYVAL nIters AS INTEGER, RetVal AS SINGLE) EXPORT

  DIM II AS INTEGER, _
      IJ AS INTEGER, _
      X1 AS INTEGER, _
      X2 AS INTEGER, _
      X3 AS INTEGER, _
      X4 AS INTEGER, _
      O  AS INTEGER, _
      X  AS INTEGER, _
      Z  AS INTEGER

  DIM zTime AS SINGLE

  zTime = TIMER

  Z = 0
  O = 1

  FOR X = 1 TO nIters
    FOR II= 1 TO 500
      FOR IJ = 1 TO 500
        X1 = 6
        X2 = X2 * 1
        X3 = X3 * O
        X4 = X4 + Z
        IF (X1 > 10) AND (FNX < 25) THEN ITERATE
      NEXT IJ
    NEXT II
  NEXT X

  RetVal = TIMER - zTime

END SUB